Option Public
Option Explicit

%REM
	 * =======================================================
	 * <HEADER>
	 * NAME:	MailFunctions script library
	 * VERSION:	20040214a
	 * AUTHOR(S):	Julian Robichaux ( http://www.nsftools.com )
	 * ORIGINAL SOURCE:	The OpenLog database, available as an
	 * open-source project at http://www.OpenNTF.org
	 * HISTORY:	none (this is the initial release)
	 *
	 * DISCLAIMER:
	 * This code is provided "as-is", and should be used at your own risk. 
	 * The authors make no express or implied warranty about anything, 
	 * and they will not be responsible or liable for any damage caused by 
	 * the use or misuse of this code or its byproducts. No guarantees are 
	 * made about anything.
	 *
	 * That being said, you can use, modify, and distribute this code in any
	 * way you want, as long as you keep this header section intact and in
	 * a prominent place in the code.
	 * </HEADER>
	 * =======================================================

This script library contains generic mail functions called SendMail
and SendSimpleMail that are used to easily create a mail message
and send it off. Both functions return an empty string if they run
successfully; otherwise they return a string describing the error that 
occurred.

For the SendSimpleMail function, just pass a string or array of strings
for the recipients, a subject, and some body text.

For the SendMail function, you have to create a variable of type MailData
(as defined here in the Declarations section), populate the desired 
members of that variable, and pass it to the SendMail function.

Here's a basic example:

	Call SendSimpleMail("Julian Robichaux", "Test", "This is a test message")

This is the equivalent of calling:

	Dim md As MailData
	md.sendto = "Julian Robichaux"
	md.subject = "Test"
	md.bodyText = "This is a test message"
	Call SendMail(md)

And here's an example that shows some of the more extended functionality:

	Dim md As MailData
	Dim fileList List As String
	Dim linkList List As Variant
	
	'** basic things
	md.sendto = "Julian Robichaux"
	md.subject = "Test"
	md.bodyText = "This is a test message"
	md.mood = MOOD_Private
	
	'** attach some files (you can also use a string instead of
	'** an array or list, if you've only got one file to attach)
	fileList(1) = "C:\Autoexec.bat"
	fileList(2) = "whatever.txt"
	md.attFiles = fileList
	
	'** create some additional rich text for the message body
	Dim session As New NotesSession
	Dim db As New NotesDatabase("", "names.nsf")
	Dim tempDoc As New NotesDocument(session.CurrentDatabase)
	Dim rtitem As New NotesRichTextItem(tempDoc, "body")
	Call db.AllDocuments.GetFirstDocument.RenderToRTItem(rtitem)
	Set md.bodyRTF = rtitem
	
	'** add some things to create doclinks with (you can pass either an
	'** array/list or a single object to the md.links member)
	Set linkList(1) = db
	Set linkList(2) = db.AllDocuments.GetFirstDocument
	md.links = linkList
	
	'** send it off
	Print SendMail(md)

%END REM



'** mail delivery priority constants
Const PRIORITY_HIGH = "H"
Const PRIORITY_NORMAL = "N"
Const PRIORITY_LOW = "L"

'** mood stamps
Const MOOD_Normal = "N"
Const MOOD_Personal = "P"
Const MOOD_Confidential = "C"
Const MOOD_Private = "R"
Const MOOD_ThankYou = "T"
Const MOOD_Flame = "F"
Const MOOD_GoodJob = "G"
Const MOOD_Joke = "J"
Const MOOD_FYI = "Y"
Const MOOD_Question = "Q"
Const MOOD_Reminder = "M"

'** mood stamp icons (list is populated in Initialize event)
Dim MoodIcons List As Integer

'** the data structure we'll use to pass information around with
Type MailData
	subject As String		'** subject of the message
	from As String			'** who the message is from (principal); OPTIONAL
	bodyText As String	'** text of the message (or you can use bodyRTF)
	priority As String		'** priority of the message (use PRIORITY_ constants); OPTIONAL
	mood As String			'** "mood" of the message (use MOOD_ constants); OPTIONAL
	sendto As Variant		'** who we're sending this to (either a single string or an array)
	cc As Variant			'** who we're copying this to (string or array); OPTIONAL
	bcc As Variant			'** who we're blind-copying this to (string or array); OPTIONAL
	attFiles As Variant		'** files to attach (filename string or array of strings); OPTIONAL
	links As Variant			'** NotesDatabase, NotesView, or NotesDocument to add as links (single or array); OPTIONAL
	bodyRTF As Variant	'** NotesRichTextItem that is the rich text of the message (or you can use bodyText)
End Type



Sub Initialize
	
	'** list of mood icons
	MoodIcons(MOOD_Personal) = 170
	MoodIcons(MOOD_Confidential) = 169
	MoodIcons(MOOD_Private) = 163
	MoodIcons(MOOD_ThankYou) = 85
	MoodIcons(MOOD_Flame) = 74
	MoodIcons(MOOD_GoodJob) = 159
	MoodIcons(MOOD_Joke) = 166
	MoodIcons(MOOD_FYI) = 23
	MoodIcons(MOOD_Question) = 162
	MoodIcons(MOOD_Reminder) = 10
	MoodIcons(MOOD_Normal) = 0
	
End Sub
Function SendSimpleMail (sendto As Variant, subject As String, body As String) As String
	'** a very simple wrapper around the SendMail function
	Dim md As MailData
	md.sendto = sendto
	md.subject = subject
	md.bodyText = body
	SendSimpleMail = SendMail(md)
End Function
Private Function AttachFile (body As NotesRichTextItem, fileName As Variant) As Integer
	'** attach a file to a rich text item
	On Error Goto linkError
	
	If (body Is Nothing) Then
		AttachFile = False
		Exit Function
	End If
	
	Dim fileNameString As String
	fileNameString = Cstr(fileName)
	
	Call body.EmbedObject(EMBED_ATTACHMENT, "", fileNameString)
	AttachFile = True
	Exit Function
	
linkError:
	Call body.AppendText("[Error " & Err & " attaching file '" & fileNameString & "': " & Error$ & "]")
	AttachFile = False
	Exit Function
	
End Function
Private Function AddDocLink (body As NotesRichTextItem, link As Variant) As Integer
	'** add a doclink to a rich text item
	On Error Goto linkError
	
	If (body Is Nothing) Then
		AddDocLink = False
		Exit Function
	End If
	
	Call body.AppendDocLink(link, "")
	AddDocLink = True
	Exit Function
	
linkError:
	Call body.AppendText("[Error " & Err & " adding link: " & Error$ & "]")
	AddDocLink = False
	Exit Function
	
End Function
Function SendMail (md As MailData) As String
	'** create and send an e-mail, based on information in the 
	'** MailData structure that was passed to us
	On Error Goto mailError
	
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim doc As NotesDocument
	Dim body As NotesRichTextItem
	
	Set db = session.CurrentDatabase
	Set doc = New NotesDocument(db)
	Set body = New NotesRichTextItem(doc, "Body")
	
	'** basic mail message stuff
	doc.Form = "Memo"
	doc.SendTo = md.sendto
	doc.CopyTo = md.cc
	doc.BlindCopyTo = md.bcc
	doc.Subject = md.subject
	
	'** change the apparent sender, if desired
	If (Len(md.from) > 0) Then
		doc.Principal = md.from
	End If
	
	'** since we're sending this automatically, we don't want out of office messages
	doc.~$AutoForward = "1"
	
	'** add priority, if desired
	If (Len(md.priority) > 0) Then
		doc.DeliveryPriority = md.priority
	End If
	
	'** add mood stamps, if desired
	If (Len(md.mood) > 0) Then
		doc.~$Moods = md.mood
		doc.SenderTag = md.mood
		If Iselement(MoodIcons(md.mood)) Then
			doc.~_ViewIcon = MoodIcons(md.mood)
		End If
	End If
	
	'** create the body of the message
	Call body.AppendText(md.bodyText)
	Call body.AddNewline(2)
	
	'** add any rich text that was passed to us
	If Not Isempty(md.bodyRTF) Then
		If (md.bodyRTF Isa "NotesRichTextItem") Then
			Call body.AppendRTItem(md.bodyRTF)
			Call body.AddNewline(2)
		End If
	End If
	
	'** add any doclinks that were passed to us
	If Not Isempty(md.links) Then
		Call body.AppendText("DocLinks:")
		Call body.AddNewline(1)
		
		If Isarray(md.links) Or Islist(md.links) Then
			Forall link In md.links
				Call AddDocLink(body, link)
			End Forall
		Else
			Call AddDocLink(body, md.links)
		End If
		
		Call body.AddNewline(2)
	End If
	
	'** attach any files that were passed to us
	If Not Isempty(md.attFiles) Then
		Call body.AppendText("Attached Files:")
		Call body.AddNewline(1)
		
		If Isarray(md.attFiles) Or Islist(md.attFiles) Then
			Forall fileName In md.attFiles
				Call AttachFile(body, fileName)
			End Forall
		Else
			Call AttachFile(body, md.attFiles)
		End If
		
		Call body.AddNewline(2)
	End If
	
	'** and finally, try to send the message
	Call doc.Send(False)
	Exit Function
	
mailError:
	SendMail = "Error " & Err & " on line " & Erl & ": " & Error$
	Exit Function
	
End Function